00100	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200	C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
00300	C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400	
00500	
00600	C   6/10/72 **********  SCORE  **********  LELAND SMITH, SEP.1969
00700	
00800	C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
00900	C   GENERATION PROGRAM.
01000	C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100	C   LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200	C   SCANW, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300	C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400	C	SUBROUTINE SUBR
01500	C	COMMON /INS/ INST(27),BG(60)
01600	C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
01700	C   INUM=INST#  IPAR=PARAM#  
01800	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
02000	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
02100	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
02200	C   F1=86  F15=100 (NO F16!)
02300	
02400		COMMON /Q/ BNW(100),NWZ /INS/INST,BG /TYP/SOS,JOUT
02500	CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
02600		DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
02700		1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
02800		1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4),JNP(80)
02900		1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
03000		1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
03100	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
03200	C   40 LIT CHARS + 30 PARAMS PER INST.
03300	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
03400		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600		1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03700		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
03800		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
03900		1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
04000		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4)),(INP,JNP)
04200		1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
04300		1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
04400		1 ,(IFM4,IFM(4)),(IFM(3),LIST)
04500		DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
04600		1, JFM(3)/','/
04700	C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
04800		DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900		1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000		1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05100		1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
05200		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
05300		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
05400		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
05500		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
05600		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
05700		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
05800		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
05900		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
06000		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
06100		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
06200		1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
06300		CALL ERRSET(0)
06400	C  SUPPRESSES UNWANTED ERR MESSAGES
06500		LPAR=0
06600		IPRN=0
06700		QX=0.
06800		MOT=0
06900		RETRO=-1.
07000		INVRT=-1
07100		LCNT=1
07200		PARENS=0
07300	      JZ=1  
07400		CALL RNDINT
07500	C  INIT RAND NUM GENERATOR.
07600	      PR=0  
07700		IAMP=0
07800	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07900	      T5=0  
08000	      NINS=0
08100		K=0
08200		IDALL=-1
08300		QTS=-1.
08400	      KB=0  
08500	      NWZ=1
08600		BNW(1)=0
08700		I=1
08800	      KL=0  
08900	      TP=0  
09000		KN=IBLA
09100	      RA=0  
09200	      CHN=0 
09300		DO 127 K=1,77,3
09400	127	LIST(K)=0
09500	C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09600		NWX=0
09700		BY=-1
09800	      DO 1128 K=1,KZY     
09900		INVIS(K)=0
10000		INST(K)=0
10100		CNT(K)=0
10200		RDEV(K)=0
10300	C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10400		NP(K)=0
10500		IQ(K)=0
10600	C   IQ IS FOR RESTART FLAG
10700		IPT(K,1)=0
10800	      DO 1128 L=1,32    
10900	1128   PCH(K,L)=0 
11000	
11100		ITYP=-1
11200	C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11300	C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
11400		JED=-1
11500	2112	TYPE 8002
11600	1112	ACCEPT 77732,INP
11700		JFM(4)='5F)'
11800		JFM(1)='   (A'
11900	C   FOR FREE 'A' FORMAT
12000		CALL FMT(JFM,INP,MLX)
12100		REREAD JFM,K,TF,AMPFAC,OP1,DURX
12200	C  JFM IS THE CURRENT FORMAT STATEMENT
12300		IF(K.NE.'EDIT')GO TO 3112
12400		JED=0
12500		GO TO 2112
12600	C  'E(DIT)' GOES TO EDIT MODE
12700	3112	IF(TF.EQ.0)TF=1.
12800		IF(AMPFAC.EQ.0)AMPFAC=1.
12900	21122	IF(K.NE.'TYPE')GO TO 128
13000		ITYP=0
13100		DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
13150		IFLNM='FOR21'
13200	CC*** 7/74 COLGATE	TYPE FINM
13300	C  TO USE TYPE-IN MODE.  FILE OF INPUT IS WRITTEN ON FOR21.DAT
13400	CC** 7/74 COLGATE	ACCEPT 1127,ISLAC
13500	CC*** 7/74 COLGATE	IF(ISLAC.EQ.IBLA)STOP
13600		REWIND 21
13700	CC** 7/74 COLGATE	WRITE (21,1127) ISLAC
13800		GO TO 3127
13900	11122	FORMAT(1XA5,72A1)
14000	128	IF(K.NE.'INFO')GO TO 3128
14100		TYPE 8002
14200		TYPE 1113
14300		TYPE 118
14400		TYPE 1114
14500		TYPE 8002
14600		GO TO 1112
14700	118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14800	CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
14810	8002	FORMAT(' **** NEW VERSION ****',//' TYPE FILE NAME--  '$)
14900	8001	FORMAT(A5,5F)
15000	107	FORMAT(I,A5,5F)
15100	1113	FORMAT('     NAME, TF, AMPFAC, OMIT", DUR".'/)
15200	1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15300		1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15400		1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15500	1127	FORMAT(A5,72A1)
15600	3128	IF(K.NE.IBLA)IFLNM=K
15700		CALL IFILE(1,IFLNM)
15790	CC*** 7/74 COLGATE	READ(1,107)LN,ISLAC
15800		READ(1,107)LN,IXIN
15802	C  CHECK FOR LINE NUMBERS ONLY.
15805		REWIND 1
15810		CALL IFILE(1,IFLNM)
15900	CC*** 7/74	REREAD 77732,JNP
16000	C   FOR LATER USE
16100	CC** 7/74	IF(LN.NE.0)GO TO 3127
16200	C   JUMP IF THE FILE HAS LINE NUMBERS.
16300	CC*** 7/74	REREAD 1127,ISLAC
16400	C   REREADS FIRST LINE
16500	
16610	3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
16655	C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
16660	5127	TYPE 118
16700		IF(DURX.EQ.0)DURX=19999.
16800		IXIN=1
16900	CC -- NOW AT TOP OF PAGE 4(2/74)	DO 1107 K=1,30
17000	CC1107	PL(K)=1.
17100		INONLY=-1
17200		ACCEPT 300,MX,X,Y,Z
17210		IF(MX.NE.99)GO TO 6127
17220		TYPE FINM
17230		ACCEPT 1127,ISLAC
17240		GO TO 5127
17300	6127	IF(Z.NE.0)INONLY=Z
17400		IF(X.NE.0)IXIN=X
17500	C   MX=3 GIVES DURS ONLY
17600	C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
17700	C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
17800		MZ=0
17900		JOUT=5
18000	C  5=OUTPUT TO TTY
18100		SOS=-1.
18200		IF(Y.NE.0)SOS=0  
18300	C  IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18400		IF(MX.NE.22)GO TO 2107
18500		JOUT=3
18600	C DIRECT TO LPT AT COLGATE 6/74
18700	CC	JOUT=22
18800	CC	REWIND 22
18900	2107	IF(MX.LE.1)MX=MX-2
19000		IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19100		IF(MX.EQ.4)MZ=-4
19200	CC	IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19300	CC*** 7/74 COLGATE	IF(SOS.AND.ITYP)CALL COLTTY(JNP,JOUT,3)
19400	
19500	C   *************** READS INPUT  ***********************
19600	2308	IF(ITYP)GO TO 2127
19700		DATA TINST /25H(' TYPE INST NAME, ETC'/)/
19800		1,TEDIT/20H(' RETYPE LINE?'/  )/
19900	23081	TYPE TINST
20000		ACCEPT 77732,JNP
20100	CC	IF(JED)WRITE(21,77732)INP
20200		IF(JED)CALL COLTTY(JNP,21,5)
20300		JFM(4)='72A1)'
20400	C  PUTS ON LPT AND TTY
20500		GO TO 1074
20600	CC 6/74 COLGATE2127	JREAD=1
20700	CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
20800	2127	IF(READER(JNP))GO TO 2337
20900	C  READS A LINE.  IF END OF FILE, JUMPS.
21000	CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
21100	CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
21200	CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD
21300	
21400	441	JFM(4)='72A1)'
21500		IF(LN.EQ.0)GO TO 1074
21600		REREAD 2114,LN,INP
21650	C****  READS ONLY FILES WITH LINE NUMBERS!
21700		JFM(1)=' (I,A'
21800		CALL FMT(JFM,INP,MLX)
21900		REREAD JFM,LN,J,INP
22000		GO TO 4127
22100	1074	JFM(1)='   (A'
22200		CALL FMT(JFM,INP,MLX)
22300		REREAD JFM,J,INP
22400	4127	IF(JED.OR.K.EQ.'Y')GO TO 41271
22500	C  K CHECK IS TO PASS AFTER RETYPING
22600		TYPE TEDIT
22700		ACCEPT 77732,K
22800		IF(K.EQ.'Y')GO TO 23081
22900		IF(K.EQ.'G')JED=-1
23000	
23100	
23200	41271	IF(J.EQ.IBLA)GO TO 2308
23300		MLX=1
23400		IZ=0
23500		JA=-1
23600		ISUB=4
23700		ALL=1.
23800		VX1=0
23900		VX2=0
24000		VX3=0
24100		LK=-1
24200		K=0
24300		IF(V(I-1).NE.-9900.-BY)GO TO 364
24400		BY=-1.
24500		I=I-1
24600	364	DO 361 JD=1,72
24700		N=INP(JD)
24800		IF(N.NE.'R')GO TO 361
24900	C  LOOKS FOR 'RESTART'
25000		DO 3611 M=JD,72
25100		KL=INP(M)
25200		IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25300	3611	INP(M)=IBLA
25400	C   CHANGES 'RESTART' TO BLANKS
25500	3631	DO 363 N=1,NINS
25600		IF(J.NE.INST(N))GO TO 363
25700		IQ(N)=-1
25800	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
25900		GO TO 362
26000	363	CONTINUE
26100	361	IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
26200	6773	K=K+1
26300		IF(K.GT.NINS)GO TO 36
26400		IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
26500	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
26600		LK=K
26700		GO TO 1773
26800	36	IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
26900		IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6  
27000		IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27100		1GO TO 1773
27200		IF(J.EQ.'SECTI')GO TO 1081
27300	C******************  ABOVE AND BELOW FOR 'SECTIONS'
27400		IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
27500	362	LK=NINS+1
27600		IF(LK.GT.KZY)GO TO 99
27700		INST(LK)=J
27800		IZ=LK
27900		GO TO 1773
28000	
28100	C*********** DOWN TO 99 FOR 'SECTIONS'
28200	1083	V(I)=-99.
28300		KL=1
28400		GO TO 3083
28500	C  READS 'PLAY SECT. N1,N2'
28600	1081	V(I)=-199.
28700		KL=4
28800	3083	DO 2081 K=KL,72
28900		IF(INP(K).EQ.IBLA)GO TO 2081
29000		IV(I+1)=INP(K)
29100		I=I+2
29200	3081	BY=-1.
29300		GO TO 2308
29400	2081	CONTINUE
29500	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
29600	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
29700	C********* FEB 15,71
29800	1082	V(I)=-299.
29900		I=I+1
30000		GO TO 3081
30100	C   MARKS END OF SECTION
30200	C************************
30300	
30400	99	TYPE 199,LN
30500		STOP
30600	199	FORMAT(' ERROR!!  LAST LINE READ =',I6/)
30700	4	IF(LK.LE.NINS)GO TO 8773
30800		IF(ALL.GT.0)GO TO 1004
30900		IF(IDALL.GT.0)GO TO 8773
31000		BG(LK)=VX1
31100		IDALL=LK
31200		GO TO 2004
31300	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31400	1004	BG(LK)=VX1
31500		IF(LK.EQ.IZ)VX1=0
31600	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
31700	C   CHECK EFFECT ON 'MOVE'!
31800	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
31900	2004	NINS=LK
32000		IF(VX3.NE.0)VX2=10000.+VX3
32100		IF(VX2.EQ.0)VX2=-1
32200		DUR(LK)=VX2
32300		GO TO 900
32400	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
32500	8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
32600	900	IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
32700	C*********** 'PLAY' IS FOR 'SECTIONS'
32800		BY=VX1
32900	C  BY=CURRENT BG TIME.
33000		V(I)=-9900.-BY
33100		I=I+1
33200		IF(NWZ.NE.0)CALL BGSORT(BY)
33300	5773	IF(J.EQ.'TEMPO')GO TO 1106
33400		IF(J.EQ.'CONDU')GO TO 3018
33500		IF(J.EQ.'PLAY')GO TO 1083
33600	C*********** ABOVE FOR 'SECTIONS'
33700	4773	NW=LPAR
33800		IF(I.GT.1900.)TYPE 107,I
33900		ALL=1.
34000		DF=0
34100		ISUB=1
34200	1299	IF(JZ.NE.0)GO TO 1773
34300	
34400	
34500	7773	IF(ITYP)GO TO 77731
34600		DATA TPALN /20H(' TYPE A LINE'/)   /
34700	77734	TYPE TPALN
34800		ACCEPT 77732,JNP
34900	CC	IF(JED)WRITE(21,77732) INP
35000		IF(JED)CALL COLTTY(JNP,21,5)
35100		IF(INP1.EQ.IBLA)GO TO 77734
35200		GO TO 77733
35300	77732	FORMAT(80A1)
35400	CC87732	FORMAT(1X80A1)
35500	CC 6/74 COLGATE 77731	JREAD=2
35600	CC 6/74 COLGATE 	GO TO 4400
35700	77731	IF(READER(JNP))GO TO 2337
35800	C  READS A LINE.  IF END OF FILE, JUMPS.
35900	442	IF(LN.NE.0)REREAD 2114,LN,INP
36000		IF(INP1.EQ.IBLA)GO TO 77731
36100		IF(JED)GO TO 77733
36200		TYPE TEDIT
36300		ACCEPT 77732,K
36400		IF(K.EQ.'Y')GO TO 77734
36500		IF(K.EQ.'G')JED=-1
36600	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
36700	
36800	
36900	77733	MLX=1
37000	C   'LISTS' MUST END WITH * 
37100	1773	IF(IPRN.EQ.0)GO TO 17732
37200		L=I-1
37300		IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37400		IPRN=IPRN-1
37500		IF(PARENS.EQ.0)GO TO 17733
37600		PARENS=0
37700		LIST(LCNT+2)=L
37800		LCNT=LCNT+3
37900		IF(IPRN.EQ.0)GO TO 17732
38000		IPRN=0
38100	17733	LIST(MOT)=L
38200		MOT=0
38300	C   FOR ERROR TRAP
38400	
38500	17732	JZ=0
38600		N=0
38700	17731	ML=MLX
38800	
38900	C   BIG LOOP -- TO END OF PAGE 1.
39000		JD=ML
39100	975	N=INP(JD)
39200		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39300	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
39400	33611	IF(N.NE.'('.AND.N.NE.')')GO TO 2361
39500		INP(JD)=IBLA
39600		L=JD-1
39700	5113	IF(INP(L).NE.IBLA)GO TO 2113
39800		L=L-1
39900		GO TO 5113
40000	2113	IF(N.EQ.')')GO TO 3361
40100		IF(PARENS.EQ.0)GO TO 1140
40200		LCNT=LCNT+3
40300		IF(MOT.NE.0)GO TO 11403
40400		MOT=LCNT-1
40500	1140	DO 11401 JC=1,LCNT-1,3
40600		IF(INP(L).NE.LIST(JC))GO TO 11401
40700	C  FINDS DUPLICATE IDENTIFIER
40800		TYPE 11402,INP(L)
40900		GO TO 99
41000	11403	TYPE 11404
41100		GO TO 99
41200	11404	FORMAT(' MORE THAN 2 PARENS OPEN'/)
41300	
41400	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
41500	11401	CONTINUE
41600		LIST(LCNT)=INP(L)
41700		PARENS=-1.
41800		INP(L)=IBLA
41900		LIST(LCNT+1)=I
42000		GO TO 236
42100	C ''''''' FOR SINGLE QUOTES
42200	3361	IPRN=IPRN+1
42300		GO TO 236
42400	C  JUMPS BACK INTO QUOTE SECTION
42500	CQ	IF(PARENS.EQ.0)GO TO 2140
42600	CQ	LIST(LCNT+2)=L
42700	CQ	LCNT=LCNT+3
42800	CQ	PARENS=0
42900	CQ	GO TO 33612
43000	CQ2140	LIST(MOT)=L
43100	CQ	GO TO 33612
43200	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
43300	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
43400	2361	IF(N.NE.'@')GO TO 5361
43500		DO 113 L=1,72
43600		K=JD+L
43700	C   K IS USED AT 240!!!
43800		JG=INP(K)
43900		IF(JG.NE.'-')GO TO 6113
44000		RETRO=0
44100		INP(K)=IBLA
44200		GO TO 113
44300	6113	IF(JG.NE.'$')GO TO 7113
44400	C  '$' IS FOR INVERSIONS IN 'NOTES'
44500		INVRT=0
44600		GO TO 113
44700	7113	IF(JG.NE.IBLA)GO TO 4113
44800	113	CONTINUE
44900	4113	DO 6361 L=1,LCNT,3
45000		IF(JG.NE.LIST(L))GO TO 6361
45100		VX1=0
45200		DO 40 M=JD+2,72
45300		JG=INP(M)
45400		IF(JG.EQ.IBLA)GO TO 40
45500		IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
45600		ML=M
45700		GO TO 240
45800	40	CONTINUE
45900	240	JC=JA
46000		JA=-1
46100		INP(K)=IBLA
46200		CALL SCANR
46300		JA=JC
46400	140	JC=1
46500		KN=LIST(L+1)
46600		M=LIST(L+2)+1
46700		IF(RETRO)GO TO 640
46800		JC=M-1
46900		M=KN-1
47000		KN=JC
47100		JC=-1
47200		RETRO=-1.
47300	640	IF(INVRT)GO TO 940
47400	840	X=V(KN)
47500		V(I)=X+VX1
47600	C  FINDS CENTER FOR INVERSION (+TRANSP.)
47700		I=I+1
47800		KN=KN+JC
47900		IF(V(KN-JC).NE.85.)GO TO 940
48000		V(I-1)=85.
48100		GO TO 840
48200	
48300	940	Z=V(KN)
48400		IF(INVRT.EQ.0)GO TO 440
48500		IF(VX1.EQ.0)GO TO 540
48600	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
48700		IF(CODE.EQ.-33.)GO TO 440
48800		V(I)=Z*VX1
48900		GO TO 7361
49000	440	IF(Z.EQ.85.)GO TO 540
49100		Y=0
49200		IF(INVRT.EQ.0)Y=(X-Z)*2.
49300		V(I)=Z+VX1+Y
49400		GO TO 7361
49500	540	V(I)=Z
49600	7361	I=I+1
49700		KN=KN+JC
49800		IF(KN.NE.M)GO TO 940
49900	
50000		INVRT=-1
50100		RB=V(I-1)
50200		DO 8361 L=JD,72
50300		JG=INP(L)
50400	C   PUT IN NOV 25, 72
50500		IF(JG.EQ.ISEMI)GO TO 93612
50600		INP(L)=IBLA
50700		IF(JG.EQ.KSLA)GO TO 9361
50800		IF(JG.EQ.')')IPRN=IPRN+1
50900	8361	IF(JG.EQ.'*')IAMP=-1
51000	9361	MLX=L
51100	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
51200		IF(IAMP.EQ.0.AND.QTS)GO TO 1773
51300		JZ=-1
51400	93612	IF(IAMP.EQ.0)GO TO 93611
51500	C   NOV 25, 72
51600		IF(QTS)GO TO 3013
51700		GO TO 2722
51800	C  THESE ARE FOR "LIT" ITEMS
51900	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
52000	C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
52100	93611	IF(JG.EQ.ISEMI)GO TO 7773
52200		JZ=0
52300		IF(IPRN.NE.0)GO TO 1773
52400	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
52500		GO TO 236
52600	C  LAST TIME FOR QUOTES
52700	
52800	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
52900	C   JUMPS TO END STRING OF QUOTES
53000	6361	CONTINUE
53100		GO TO 99
53200	C @@@@@@@@@@@@@@@@@@@@@@@@@@
53300	5361	IF(N.EQ.'$')GO TO 99
53400	C  FOUND $  BUT NO @!
53500		IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
53600		IF(INP(JD+1).NE.IF)GO TO 236
53700	C  JUMP IF NOT DUTY FACTOR
53800		DF=DF-100.
53900		GO TO 43615
54000	53611	IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
54100		DF=DF-200
54200	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
54300		GO TO 43615
54400	53612	IF(N.NE.IAA)GO TO 43611
54500	C   FINDS 'ALL'.
54600		IF(INP(JD+1).NE.'L')GO TO 236
54700		ALL=-1.
54800		GO TO 43615
54900	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
55000	
55100	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
55200	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
55300	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
55400	C   BEFORE! QUAD (IF USED).
55500	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
55600	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
55700	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
55800	43611	IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
55900		QX=-13.
56000		DO 43612 N=JD,72
56100		J=INP(N)
56200		IF(J.EQ.IXX)QX=QX-1.
56300		IF(J.EQ.IF)QX=QX-2.
56400		IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
56500	43612	INP(N)=IBLA
56600	4361	IF(N.NE.'I')GO TO 43613
56700		IF(ISUB.NE.4)GO TO 43613
56800	C  NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
56900		INVIS(LK)=-1
57000	43615	DO 43614 L=JD,72
57100		N=INP(L)
57200		IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
57300	43614	INP(L)=IBLA
57400	43613	IF(N.NE.KSLA)GO TO 636
57500		MLX=JD+1
57600		JZ=-1
57700		INP(JD)=ISEMI
57800	436	IF(INP(MLX).NE.IBLA)GO TO 336
57900		MLX=MLX+1
58000		GO TO 436
58100	636	IF(N.NE.ISEMI)GO TO 936
58200	336	IF(ISUB.EQ.104)GO TO 104
58300		IF(ISUB.GT.3)GO TO 1899
58400	   	GO TO (101,102,103),ISUB
58500	C             PAR  MOV LIST  OTHERS
58600	936	IF(N.NE.IDOT)GO TO 736
58700		L=INP(JD+1)
58800		DO 836 KL=1,10
58900	836	IF(L.EQ.IDAT(KL))GO TO 236
59000		IF(CODE.EQ.-22.)INP(JD)=1
59100		GO TO 236
59200	C   CHANGES DOTTED RHYTHMS TO '1'S.
59300	736	IF(N.NE.'*')GO TO 136
59400		IAMP=-1
59500		INP(JD)=IBLA
59600	C  ******* WAS ISEMI ****** WHY?
59700	136	IF(N.NE.IQT)GO TO 236
59800		DO 1361 K=JD+1,72
59900		IF(INP(K).NE.IQT)GO TO 1361
60000		JD=K+1
60100		GO TO 975
60200	C   SKIPS MATERIAL IN QUOTES
60300	1361	CONTINUE
60400		GO TO 99
60500	C   OPEN QUOTES
60600	236	JD=JD+1
60700		IF(JD.LT.73)GO TO 975
60800		TYPE 1236
60900		GO TO 99
61000	1236	FORMAT(' MISSING SEMICOLON')
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00500	C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600		JA=-1
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.EQ.'R')GO TO 2337
01000	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01100		IF(N.EQ.ID)GO TO 7720
01200		GO TO 99
01300	1	CALL SCANR
01400	 	LPAR=VX1
01500		IJ=LPAR
01600		IF(QX.GE.0)GO TO 5703
01700		IJ=LPAR+4
01800	C  SETS UP PARAM FOR QUAD CALL
01900		V(I)=IJ+LK*10000
02000		V(I+1)=2*ALL
02100	C  TEST "ALL" FEATURE HERE!!!!!!!
02200	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300		V(I+2)=QX
02400		I=I+3
02500		QX=0.
02600	5703	IAMP=0
02700		IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800		IF(LPAR.EQ.32)LPAR=1
02900		V(I)=LPAR+LK*10000
03000	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100		IJ=I+1
03200		I=I+4
03300		ITMP=0
03400		CODE=0
03500		NFLG=1
03600		ML=IZ+M
03700	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
03800	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
03900	C  QU=QUADC  QUX=QUADX 
04000	5702	ML=ML+1
04100		IF(ML.GT.72)GO TO 99
04200		N=INP(ML)
04300		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400		NL=INP(ML+1)
04500		JA=-1
04600		ISUB=0
04700		IF(N.EQ.IXX)GO TO 2703
04800		IF(N.EQ.'R')GO TO 6702
04900		IF(N.EQ.IF)GO TO 8702
05000	4005	JA=0
05100		IF(N.EQ.IEN)GO TO 6005
05200		IF(N.EQ.'M')GO TO 703
05300		IF(N.EQ.'L')GO TO 2720
05400		IF(N.EQ.ISS)GO TO 6703
05500		IF(N.EQ.ITT)GO TO 4018
05600		IF(N.EQ.IQT)GO TO 5720
05700		IF(N.EQ.ISEMI)GO TO 2018
05800		IF(N.EQ.IPP)JA=-1
05900	C  FOR /P5  P3/
06000		CALL SCANR
06100		IF(ISUB.EQ.8)GO TO 8
06200		I=I+JJ
06300		V(IJ+1)=NNUM+DF
06400		IF(JJ.EQ.1)GO TO 4006
06500	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
06600		IF(NNUM.NE.-2)GO TO 5006
06700		IX=IJ+3
06800		DO 2006 K=2,JJ,3
06900	2006  CALL RANR(VX,K)
07000	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
07100	5006	IX=IJ+2
07200		DO 6006 K=1,JJ
07300	6006	V(IX+K)=VX(K)
07400		V(IX+JJ-2)=1.
07500	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07600		GO TO 3013
07700	4006	IF(JA)VX1=VX1/100.+9999.
07800	C  CHANGES /P5 P3/ TO /P5 9999.03/ ***** CHECK OUT ON OTHER MACHINES!
07900		V(I-1)=VX1
08000		GO TO 3013
08100	6702	IF(NL.EQ.IE)GO TO 2703
08200	C   JUMP IF "REP"
08300		IF(NL.EQ.ITT)GO TO 4018
08400	C   JUMP IF "RTAP"
08500		CODE=-22
08600		IF(NL.EQ.'L')CODE=-46.0
08700	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
08800		IF(NL.NE.IEN)GO TO 1016
08900	C   JUMP IF NOT "RNOTES"
09000		JA=0
09100	C   FOR SCANR
09200		CODE=-36.
09300		GO TO 1016
09400	6005	CODE=-33
09500		IF(NL.NE.'U')GO TO 1016
09600		CODE=-44.
09700	1610	JA=-1
09800		GO TO 1016
09900	8702	CODE=-35
10000		IF(NL.EQ.'U')GO TO 1016
10100		ML=ML+1
10200		CALL SCANR
10300	7	V(IJ+1)=CODE+DF
10400		V(IJ+2)=1.
10450		IF(VX1.GT.15)GO TO 99
10475	C TRAPS F NUMS >15.
10500		V(I)=VX1+85.
10600		GO TO 7703
10700	C********  MOVE IS NEXT ***********
10800	703	BW=V(IJ-2)
10900		IC=0
11000		DO 7031 K=ML+1,72
11100		IF(INP(K).EQ.ISEMI)GO TO 8031
11200	7031	IF(INP(K).EQ.IXX)IC=-1
11300	C   IC=-1 IS FOR MOVX
11400	8031	I=I-1
11500		V(I)=0
11600		X=-9900.-BY
11700		IF(BY.EQ.0)X=-9900.-BG(LK)
11800	   	IF(BW.EQ.X)GO TO 8005
11900		IF(BW.NE.-9900.-BY)GO TO 1102
12000		V(IJ-2)=X
12100		GO TO 8005
12200	1102	V(IJ)=V(IJ-1)
12300		V(IJ-1)=X
12400		IJ=IJ+1
12500		I=I+1
12600	8005	LP=IJ-1
12700		BW=-9900.-X
12800		ISUB=2
12900		IZ=-1
13000	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13100	4703	GO TO 1299
13200	102	IF(IZ.LT.0)GO TO 2102
13300	C  SKIPS NEXT FIRST TIME
13400		BW=V(ICT)+BW
13500		V(I)=-9900.-BW
13600		V(I+1)=V(LP)
13700		V(I+2)=(JJ+2)*ALL
13800		V(I+3)=CODE+DF
13900		I=I+4
14000		IZ=1
14100	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
14200	C   ROUND-OFF NONSENSE
14300	2	VX3=-9900.
14400		VX2=VX3 
14500		CALL SCANR
14600		IF(JJ.GT.0)GO TO 5102
14700		JJ=ILIT
14800	C SLASH WILL REPEAT MOVE INPUT -- 6/74
14900		DO 6102 K=1,JJ
15000	6102	VX(K)=VX(K+20)
15100		GO TO 5005
15200	C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15300	5102	IF(JJ.EQ.4)GO TO 99
15400	C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
15500		IF(VX3.NE.-9900.)GO TO 3102
15600		IF(VX2.NE.-9900.)GO TO 4102
15700		VX2=VX1
15800		VX1=10000.
15900	4102	VX3=VX2
16000		JJ=3
16100	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16200	3102	IF(IZ.GE.0)GO TO 3006
16300		V(IJ)=(JJ+2)*ALL
16400	C  WORD COUNT
16500		CODE=-55.
16600		IF(JJ.NE.3)CODE=-57.
16700		IF(NFLG)CODE=CODE-1.
16800		IF(IC)CODE=-59.
16900	C  CODE=-56 OR -58 FOR NOTES.
17000		V(IJ+1)=CODE+DF
17100		IZ=0
17200	3006	IF(NFLG.EQ.1)GO TO 5005
17300	      CALL RANR(VX,2)
17400	      IF(JJ.NE.3)CALL RANR(VX,4)
17500	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
17600	5005	ICT=I
17700		ILIT=JJ
17800	C  SAVES FOR SLASH REPEAT FEATURE
17900	  	IJ=IJ+1
18000		DO 1006 K=1,JJ
18100		VX(20+K)=VX(K)
18200	C  SAVES FOR SLASH REPEAT FEATURE
18300	1006	V(IJ+K)=VX(K)
18400		I=I+JJ  
18500		IJ=I+2
18600		IF(IAMP.EQ.0)GO TO 1299
18700	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18800		V(I)=-9900.-BY
18900		GO TO 8703
19000	
19100	7703	V(IJ)=4.*ALL
19200	8703	I=I+1
19300		GO TO 4773
19400	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
19500	6703	CODE=-12.
19600		IF(INP(ML+3).EQ.'L')CODE=-11.
19700		V(IJ)=2.*ALL
19800		V(IJ+1)=CODE+DF
19900		I=I-1
20000		GO TO 4773
20100	4018	CNT(LK)=-9900.-BY
20200		P(LK)=V(I-4)
20300	CC 6/74 COLGATE 	JREAD=3
20400	CC 6/74 COLGATE	GO TO 4400
20500		IF(READER(JNP))GO TO 2337
20600	C  READS A LINE.  IF END OF FILE, JUMPS.
20700	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20800		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
20900	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
21000		IF(NL.NE.ITT)GO TO 2338
21100		CODE=-23.
21200		GO  TO 1016
21300	2338	I=I-4
21400		GO TO 4773
21500	3018	CNT(KZY)=-9900.
21600	CC	JREAD=4
21700	CC COLGATE 6/74	GO TO 4400
21800		IF(READER(JNP))GO TO 2337
21900	C  READS A LINE.  IF END OF FILE, JUMPS.
22000	444	IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
22100		IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
22200		P(KZY)=980000.
22300		GO TO 2308
22400	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22500	C  'REP'
22600	2703	ML=ML+1
22700		VX1=0
22800		VX2=0
22900		VX3=0
23000		IF(N.EQ.IXX)GO TO 2704
23100		INP(ML)=IBLA
23200		INP(ML+1)=IBLA
23300	C  WIPES OUT 'EP' IN 'REP'
23400	2704	CALL SCANR
23500	 	V(IJ)=3.
23600		V(IJ+1)=-66.0
23700		IF(VX1.EQ.32.)VX1=1.
23800		IF(VX1.EQ.0)VX1=LPAR
23900		IF(VX2.EQ.0)VX2=LK-1
24000		V(IJ+2)=VX1+VX2*10000.
24100		KL=VX2
24200		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24300		IF(VX3.EQ.0)GO TO 4773
24400		L=VX3
24500		ML=LK+1
24600		DO 1018 KL=ML,L
24700		IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24800		IF(DUR(KL))DUR(KL)=DUR(LK)
24900	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25000		V(I)=V(I-4)+10000.
25100		V(I+1)=3.
25200		V(I+2)=-66.
25300		V(I+3)=V(I-1)
25400	1018	I=I+4
25500		GO TO 4773
25600	
25700	2018	IF(DF.EQ.0)GO TO 20181
25800	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25900		V(IJ+1)=-201.
26000		V(IJ+2)=1.
26100		V(IJ+3)=0
26200		GO TO 7703
26300	20181	V(IJ)=3.
26400		V(IJ+1)=-66.
26500		V(IJ+2)=NW+LK*10000
26600		GO TO 4773
26700	C  READS /P5  .3 "ABC" .7 "XYZ"/
26800	
26900	8 	V(IJ+1)=-77.+DF
27000	C  DF HAS SUBR CALL INFO
27100		I=I+1
27200		VX(JJ-1)=1
27300	C  FOR RAND. SINGLE LITS.
27400		DO 3722 K=1,JJ,2
27500		V(I)=VX(K)
27600	3722	I=I+1
27700		V(IJ+2)=JJ/2
27800		V(IJ+3)=I
27900		DO 4722 K=2,JJ,2
28000		KN=I
28100		I=I+1
28200		L=VX(K)
28300		DO 6722 KL=L,72
28400		IF(INP(KL).EQ.IQT)GO TO 4722
28500		IV(I)=INP(KL)
28600	6722	I=I+1
28700	4722	V(KN)=I-KN-1
28800		V(IJ)=(I-IJ)*ALL
28900		GO TO 4773
29000	2720	QTS=0
29100		ISUB=104
29200		GO TO 1299
29300	
29400	104	DO 6721 K=ML,72
29500		JC=K+1
29600		IF(INP(K).EQ.IQT)GO TO 7721
29700	6721	IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29800	C  FOR REPEAT OF ITEM BY SLASH
29900	CC7232	DO 7231 K=I-1,1,-1
30000	CC CHNGD 6/74	IF(ABS(V(K)).GT.72.)GO TO 7231
30100	CC	NL=V(K)
30200	CC	DO 7230 KL=K,K+NL
30300	7232	DO 7230 KL=ILIT,ILIT+NLIT
30400		V(I)=V(KL)
30500	7230	I=I+1
30600		GO TO 27222
30700	7231	CONTINUE
30800	
30900	5720	IAMP=-1
31000		JC=ML+1
31100	C  FOR SINGLE 'LIT' ITEMS.
31200	7721	DO 1722 KL=JC+1,72
31300		IF(INP(KL).NE.IQT)GO TO 1722
31400		JD=KL-1
31500		ML=KL+1
31600		NLIT=KL-JC
31700	C   EXTENT OF LIT ITEM IS FOUND
31800		GO TO 8721
31900	1722	CONTINUE
32000	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
32100	8721	V(I)=NLIT
32200		ILIT=I
32300		DO 9721 K=JC,JD
32400	C   PUTS ITEM IN "IV" ARRAY
32500		I=I+1
32600	9721	IV(I)=INP(K)
32700		I=I+1
32800	27222	IF(IAMP.EQ.0)GO TO 1299
32900	2722	V(I)=999.
33000		QTS=-1.
33100	27221	V(IJ+1)=-88.+DF
33200		V(IJ)=(I-IJ+1)*ALL
33300		IJ=IJ+2
33400		V(IJ)=IJ+1
33500		I=I+1
33600		ISUB=1
33700		GO TO 1299
33800	
33900	7720	V(I)=LK
34000		V(I+1)=3.
34100		V(I+2)=-67.
34200		ML=ML+4
34300		CALL SCANR
34400	 	V(I+3)=VX1
34500		I=I+4
34600		L=VX1
34700		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34800		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34900		GO TO 4773
35000	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
35100	142	FORMAT(I,15A5) 
35200	1301	FORMAT(15A5) 
35300	2773	FORMAT(I,A5,72A1) 
35400	2114  FORMAT(I,72A1)
35500	300	FORMAT(I,3F,A1)
35600	301	FORMAT(3F,A1)
35700	6 	KB=KB+1
35800		IF(JED.GT.0)JED=0
35900		IF(J.EQ.'INSER')GO TO 1340
36000	      OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
36100	      GO TO 340   
36200	1340	X=VX1
36300		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
36400		OTH(KB,1)=X
36500		GO TO 1338
36600	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36700	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
36800	C   - BEGIN LINE WITH  <,END WITH ; 
36900	C   UP TO 75 CHARACTERS MAY BE TYPED.     
37000	340      IF(VX3.NE.2)GO TO 1338 
37100		IF(ITYP.GE.0)GO TO 449
37200	CC	JREAD=5
37300	CC 6/74  COLGATE	GO TO 4400
37400		IF(READER(JNP))GO TO 2337
37500	C  READS A LINE.  IF END OF FILE, JUMPS.
37600	445	OTH(KB,3)=1.
37700		IF(LN.EQ.0)GO TO 447
37800		REREAD 300,K,OTH(KB,2)
37900		GO TO 1447
38000	447	REREAD 301,OTH(KB,2)
38100	1447	IF(JED)GO TO 2308
38200	3445	TYPE TEDIT
38300		ACCEPT 77732,K
38400		IF(K.EQ.'G')JED=-1
38500		IF(J.EQ.'INSER')GO TO 3446
38600		IF(K.NE.'Y'.OR.JED)GO TO 2308
38700	449	TYPE TPALN
38800		ACCEPT 301,OTH(KB,2)
38900		IF(JED)WRITE(21,301) OTH(KB,2)
39000		GO TO 2308
39100	
39200	1338	IF(ITYP.GE.0)GO TO 1449
39300	CC	JREAD=6
39400	CC 6/74 COLGATE	GO TO 4400
39500		IF(READER(JNP))GO TO 2337
39600	C  READS A LINE.  IF END OF FILE, JUMPS.
39700	446	IF(LN.EQ.0)GO TO 448
39800		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
39900		GO TO 1446
40000	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
40100	1446	IF(JED)2446,3445,2446
40200	3446	IF(K.NE.'Y'.OR.JED)GO TO 2446
40300	1449	TYPE TPALN
40400		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
40500		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
40600	2446	X=OTH(KB,2)
40700		IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40800		IF(X.EQ.'*')KB=KB-1
40900	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41000	C   LAST LINE HAS '*' IN COLUMN 1.
41100		GO TO 2308
41200	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
41300	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
41400	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
41500	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
41600	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41700	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41800	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
41900	1899	CALL SCANR
42000		GO TO(1,2,3,4,5,6),ISUB
     

00100	1106	KTMP=1
00200		TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2/TP
01300		V(I+4)=VX3/TP
01400		I=I+5
01500		BY=BW
01600	C  SEPT 18, 70
01700		IF(VX1.EQ.0)GO TO 2308
01800		BW=BW+VX1
01900		V(I)=-9900.-BW
02000		I=I+1
02100		CALL BGSORT(BW)
02200	9003	IF(IAMP)GO TO 4003
02300	2016	VX3=0
02400		VX2=0
02500		GO TO 1299
02600	5	IF(VX2.NE.0)GO TO 105
02700	C  'TEMPO/120*;'  OR  'TEMPO/1.5 72*;'  IS OK.
02800		VX2=VX1
02900		VX1=0
03000	105	IF(VX3.EQ.0)VX3=VX2
03100		IF(VX2.LT.11.)TP=1.
03200		IF(J.EQ.ITMPO)GO TO 3019
03300	  	PCH(1,KTMP)=VX1
03400		PCH(2,KTMP)=VX2
03500		PCH(3,KTMP)=VX3
03600	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
03700		KTMP=KTMP+1
03800		IF(IAMP.EQ.0)GO TO 2016
03900	4003	VX1=0
04000		IAMP=0
04100		VX2=VX3
04200		IF(J.EQ.ITMPO)GO TO 3019
04300		PCH(1,KTMP)=0
04400		PCH(2,KTMP)=VX2
04500		PCH(3,KTMP)=VX2
04600	C   MM CAN BE FROM 11 UP  ITMPO FACTOR FROM 10 DOWN.  
04700	C   UP TO 30 ITMPO CHANGES MAY BE MADE.   
04800	
04900	1016      IA=I    
05000	      IZ=1  
05100	3100	V(I-2)=CODE+DF
05200	      ISUB=3     
05300	5016	IF(IAMP.GE.0)GO TO 1299
05400	117	IF(IZ-2)3013,9004,9004
05500	103	K=INP(ML)
05600		IF(K.EQ.ITT)GO TO 1106
05700		IF(K.EQ.ISEMI)GO TO 1014
05800		IF(K.NE.IBLA) GO TO 1899
05900		ML=ML+1
06000		GO TO 103
06100	3      IF(VX1.EQ.-99.)GO TO 4022
06200		IF(CODE.EQ.-22.)GO TO 2017
06300	  	IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06400	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06500	2017	IF(VX1.EQ.10000.)GO TO 17
06600	      VX1=4./VX1
06700		IF(JJ.NE.1)GO TO 2014
06800		V(I)=VX1
06900		GO TO 114
07000	
07100	1217	IF(VX1.EQ.10000.)GO TO 114
07200	C    FOR "FINE" IN LIST
07300	      V(I+1)=VX2
07400	      IF(CODE.EQ.-36.)CALL RANR(V,I)
07500	2217	I=I+1
07600	C  SETS UP STRING OF RAND SELECTIONS
07700		GO TO 114
07800	3217	V(I)=V(I-2)
07900		V(I+1)=RB
08000	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
08100		GO TO 2217
08200	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
08300	
08400	2014	DO 9006 L=2,JJ
08500		IF(VX(L).EQ.0)GO TO 17
08600	9006	VX1=4./VX(L)+VX1
08700		JJ=1
08800	17	V(I)=VX1
08900		IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
08950		IF(CODE.EQ.-35.AND.VX1.GT.15)GO TO 99
08975	C  FINDS F NUM.>15!
09000	C  JUMP IF STRING OF RAND SELECS.
09100		IF(JJ.EQ.1)GO TO 114
09200		L=VX(JJ)-1
09300		X=V(I)
09400		NL=I+1
09500		I=L+I
09600		DO 1017 K=NL,I
09700	1017	V(K)=X
09800	C   ADDS UP TOTAL   OF NOTES IN SEQ.
09900		IZ=IZ+L
10000		GO TO 114
10100	1014	IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
10200		V(I)=RB
10300	C   RB SAVES IT FOR SLASH REPEAT
10400	114      RB=V(I)     
10500	      I=I+1 
10600	      IZ=IZ+1     
10700	      GO TO 5016    
10800	4022      JC=VX2+.3
10900	      JD=VX3-.5
11000		IF(JJ.EQ.2)JD=1
11100	C********* MAY 19,71   ----MANY LINES ABOVE.
11200	      IZ=IZ+JC*JD 
11300	C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
11400	      DO 1005 K=1,JD    
11500	       NL=I+JC-1  
11600	      DO 2005 L=I,NL    
11700	2005  V(L)=V(L-JC)
11800	1005      I=I+JC  
11900		RB=V(NL)
12000	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
12100	      GO TO 5016  
12200	
12300	9004	IF(ITMP.EQ.0)GO TO 3013
12400	C*********** JUNE 1,71
12500		IZ=IZ-1
12600	C***** JAN. 1974
12700	      KA=1  
12800	      IC=1  
12900	      K=0   
13000		J=1
13100	      Z=0   
13200	      RC=0  
13300	9007	Y=PCH(3,IC)/TP
13400		X=PCH(2,IC)/TP
13500	      Z=PCH(1,IC) 
13600		CALL SQYY(YY,X,Y,Z)
13700		XT(1)=X
13800	      XA=RA 
13900	      RD=1  
14000	      RB=0  
14100	      ZZ=Z  
14200	7020      RA=V(IA+K)    
14300		IF(RA.EQ.10000.)GO TO 3013
14400	4020  RD=1  
14500	      IF(RA.LT.0)RD=-1. 
14600	      RA=RA*RD    
14700	      IF(KA.EQ.0)RA=RA-RC     
14800	      W=RA  
14900	      RB=W  
15000	      IF(W.LE.Z)GO TO 2020    
15100	      IF(Z.NE.0)GO TO 3020    
15200	      RA=RA/Y     
15300	      RB=-1.
15400	      RC=0  
15500	      GO TO 8020  
15600	3020      W=Z     
15700	      RC=W+RC     
15800	      GO TO 24    
15900	2020      RC=0    
16000	24	IF(X.NE.Y)GO TO 424
16100		RA=W/X
16200		GO TO 8020
16300	C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
16400	C   BG TIME OF NOTE. CHN=TBG.
16500	424	RAX=XT(J)
16600		RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
16700		XT(J)=RAX+YY*RA
16800	8020      IF(KA.EQ.0)RA=RA+XA 
16900	      KA=1  
17000	      IF(RC.NE.0)GO TO 1011   
17100	      IF(T5.EQ.1)GO TO 8203   
17200	      V(IA+K)=RA*RD     
17300	      IF(K.EQ.IZ)GO TO 3013     
17400	C*********** JUNE 1,71
17500	1011      IF(T5.EQ.1)GO TO 2011     
17600	      K=K+1 
17700	      IF(ZZ.NE.0)Z=Z-W  
17800	      IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020     
17900	      IC=IC+1     
18000	      IF(RB.EQ.W)GO TO 9007
18100	      KA=0  
18200	      K=K-1 
18300	      GO TO 9007     
18400	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
18500	C     ML=I-1
18600	3013	X=I-IJ
18700		V(IJ+2)=X-3.
18800		V(IJ)=X*ALL
18900		IF(CODE.NE.-35)GO TO 4773
19000		M=IJ+3
19100	C   SETS NUMBERS FOR FUNCS.
19200		DO 313 K=M,I-1
19300	313	IF(V(K).LT.85.)V(K)=V(K)+85.
19400		GO TO 4773
19500	
19600	2011      XA=RA   
19700		IF(K.GT.1)GO TO 9020
19800		K=I-6
19900	      ZPAR=-9900.-CHN-ZZ
20000	      DO 3011 KL=8,I     
20100	      IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020    
20200	3011      K=K-1
20300	9020      W=ZZ  
20400		IF(V(K+3))K=K+3
20500	C   ABOVE IS FOR TYPED IN TEMPO CHANGES
20600		KA=K+3
20700	      ZZ=V(KA)
20800	C   DUR OF NEXT TEMPI
20900		X=V(KA+1)
21000		Y=V(KA+2)
21100	213      KA=0  
21200	      Z=ZZ  
21300		CALL SQYY(YY,X,Y,Z)
21400	      CHN=CHN+W   
21500		XT(J)=X
21600	      IF(KA.EQ.1)Z=0    
21700	      RA=PR 
21800		KA=0
21900		K=K+3
22000		GO TO 4020
     

00100	2337	T=0
00200		DO 1107 K=1,30
00300	1107	PL(K)=1.
00400	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
00500		IF(ITYP)GO TO 23371
00600		END FILE 21
00700		DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
00800		TYPE ENFI
00900	C**** NOT THIS *****  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
00910	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT SCORX
01000	23371	IF(SOS)WRITE(JOUT,902)
01100	C   WRITES A BLANK LINE
01200		NWZZ=0
01300		IAMP=0
01400		IT3=0
01500		K=1
01600	      IX=0  
01700		BG(NINS+1)=19999.
01800	4011	IF(CNT(K))GO TO 5011
01900	6011	IF(K.EQ.KZY)GO TO 4337
02000		K=K+1
02100		GO TO 4011
02200	5011	L=V(I-1)/(-9900.)
02300		IF(L.EQ.1)I=I-1
02400		V(I)=CNT(K)
02500		V(I+1)=P(K)
02600		V(I+3)=-44.
02700		I=I+5
02800		IF(P(K).EQ.980000.)I=I-4
02900		KL=I
03000		REWIND 1
03100		ICT=IPT(K,1)
03200		CALL IFILE(1,ICT)
03300	9011	L=I+6
03400		READ(1,7011)(V(M),M=I,L)
03500	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
03600		IF(V(L).EQ.999.)GO TO 8011
03700		I=L+1
03800		GO TO 9011
03900	8011	IF(P(K).NE.980000.)GO TO 6337
04000		DO 7337 K=L,I,-1
04100	7337	IF(V(K).NE.999.)GO TO 8337
04200	8337	I=K-1
04300		V(I)=0
04400		V(I+1)=V(K)
04500		V(I+2)=V(K)
04600	C   K WAS I-1 ABOVE.
04700		I=I+3
04800		V(KL+1)=I-KL-1
04900	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
05000		GO TO 4337
05100	6337	DO 5337 M=I,L
05200		KN=M
05300	5337	IF(V(M).EQ.999.)GO TO 3337
05400	3337	I=KN
05500		KN=I-KL
05600		V(KL-1)=KN
05700		V(KL-3)=KN+3
05800		GO TO 6011
05900	7011	FORMAT(7F)
06000	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
06100		V(I)=-19899.
06200	      PP1=0
06300	      T6=10000.   
06400	      DO 2118 K=1,NINS  
06500		ROFF(K)=0
06600	C********* FEB 17,71
06700		M=NP(K)
06800	      IT(K)=0 
06900		IPT(K,31)=0
07000		NCNT(K,31)=1
07100		DO 2118 L=1,M
07200		NCNT(K,L)=1
07300	2118	IPT(K,L)=0
07400		DO 5013 K=1,IXIN
07500	5013	X=RAND(0.0,0.0)
07600		REWIND 1
07700		IF(MX)CALL OFILE(1,ISLAC)
07800	      NW=1    
07900		NWX=0
08000	      TDUR=0
08100		A=0
08200	      T2=1. 
08300	      T4=1. 
08400	      T5=0  
08500		J=1
08600	      MK=0  
08700	C   IS THE ABOVE NEEDED?
08800		IF(MX.NE.3)GO TO 40021
08900		K=4
09000	10023	N=AMOD(V(K),100.0)/-11.
09100	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
09200		IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
09300		1 .V(K-2).LT.10000.)GO TO 10021
09400		J=V(K+1)
09500		IF(J.EQ.1)GO TO 10024
09600		IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
09700		N=V(K-2)
09800		L=N/10000
09900		M=N-L*10000
10000		TYPE 10022,INST(L),M,J
10100	10024	K=K+ABS(V(K-1))
10200	10021	K=K+1
10300		IF(K.LT.I)GO TO 10023
10400	40021	IF(MZ.NE.-4)GO TO 1002
10500		N=1
10600	40022	K=N+1
10700		IF(N.GT.I)CALL EXIT
10800		X=V(N)
10900		IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
11000		IF(X.GE.0)GO TO 40023
11100		PRINT 4002,X
11200		N=N+1
11300		GO TO 40022
11400	40024	J=N+1
11500		GO TO 40025
11600	C  FOR 'SECTIONS'
11700	40023	J=ABS(V(K))+K-1
11800	40025	PRINT 4002,(V(K),K=N,J)
11900		N=J+1
12000		GO TO 40022
12100	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
12200	4002  FORMAT(10F12.3)
12300	1002	IF(IDALL)GO TO 600
12400		X=DUR(IDALL)
12500		DO 2002 K=1,NINS
12600	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000		IV(K-1)=0
03100	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200		RD=V(KL+2)+9900.
03300		DO 6150 L=KL+2,I
03400		M=V(L)/(-9900.)
03500		IF(M.NE.1)GO TO 6150
03600		RA=RB+RD-V(L)-9900.
03700		V(L)=-9900.-RA
03800	C  UPDATES BG TIMES INSIDE SECTION.
03900		CALL BGSORT(RA)
04000	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04100	C  UPDATES LIST OF CHANGE TIMES.
04200	6150	IF(V(L).EQ.-299.)GO TO 160
04300	5150	CONTINUE
04400	160	IL=1
04500		GO TO 3723
04600	C***********  ABOVE IS FOR 'SECTION' REPEATS
04700	4150	LK=RB/10000.+.2
04800		IF(LK.GE.98)GO TO 7700
04900		LP=RB-LK*10000
05000	C   LK=INST #   LP=PARAM #
05100		LN=IPT(LK,LP)
05200		IPT(LK,LP)=IL+2
05300		IF(RD.EQ.-66.)GO TO 726
05400		IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500		IF(RD.EQ.-23)GO TO 6700
05600	
05700	2727	ML=IPT(LK,LP)
05800		IF(MOT.GT.0)GO TO 3727
05900	C  USE NEG WDCNT FOR 'ALL'
06000		DO 4727 KL=LK+1,NINS
06100		IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200		IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300		NCNT(KL,LP)=10000
06400	4727	IF(DUR(KL))DUR(KL)=1000.
06500	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700		GO TO 727
06800	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
06900	3727	IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
07000		DO 1727 L=1,NINS
07100		DO 1727 KL=1,NP(L)
07200		IF(LN.NE.IPT(L,KL))GO TO 1727
07300		NCNT(L,KL)=10000
07400	C ******* JAN 29,70
07500		IPT(L,KL)=ML
07600	C RESETS POINTERS FOR DUPL AND REP INSTS.
07700	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
07800	1727	CONTINUE
07900	727	NCNT(LK,LP)=10000
08000	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08100	2150	IF(MOT)MOT=-MOT
08200		IL=IL+MOT+1
08300	3150	IF(V(IL))GO TO 3723
08400		GO TO 729
08500	726	RB=V(IL+3)
08600		K=RB/10000.
08700		L=RB-K*10000
08800		IPT(LK,LP)=-(K+(L-1)*KZY)
08900		GO TO 2727
09000	3726	LK=V(IL)
09100		M=V(K+1)
09200		KL=NP(M)
09300		DO 4726 L=1,KL
09400		IPT(LK,L)=IPT(M,L)
09500		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09600	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
09700	4726	CONTINUE
09800		IPT(LK,31)=IPT(M,31)
09900		K=0
10000		GO TO 2150
10100	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10200	6700	KL=IL+V(IL+1)+1.3
10300		RC=V(K-2)
10400	1770	IF(V(KL))GO TO 700
10500	2700	KL=KL+V(KL+1)+1.3
10600		GO TO 1770
10700	700	KL=KL+1
10800		IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
10900		KL=KL+3
11000		KN=IL+3
11100		LN=V(KN)+.3
11200		DO 3700 L=1,LN,2
11300		RA=V(L+KN)
11400		KA=V(L+KN+1)+.3
11500		RB=0
11600		DO 4700 LP=1,KA
11700	4700	RB=RB+V(KL+LP)
11800		DO 5700 LP=1,KA
11900	5700	V(KL+LP)=V(KL+LP)/RB*RA
12000		V(KL+KA)=V(KL+KA)+.00030
12100	3700	KL=KL+KA
12200		GO TO 2150
12300	
12400	C  BELOW FOR 'TEMPO' SETUP
12500	7700	T2=V(IL+4)
12600		T1=V(IL+3)
12700		TBG=Y
12800		TDUR=V(IL+2)
12900		CALL SQYY(AC,T1,T2,TDUR)
13000	8700	IF(TDUR.EQ.0)TDUR=10000.
13100		T5=1.
13200		T6=TBG+TDUR
13300		IT3=1.
13400		IF(LK.EQ.98)IT3=IL+2
13500		T4=1.
13600		GO TO 2150
13700	C*************** ANY WDCNTS DOWN FROM HERE. *********
13800	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
13900	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14000		RA=BT
14100		K=IL-1
14200	2726	V(K)=-9900.-RA
14300		ISUB=-1
14400		L=K+5
14500		RB=V(L)+V(L-1)
14600		V(L-1)=RA
14700		K=K+V(K+2)+2
14800		IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
14900		1 V(K).NE.-9900.-RB)GO TO 2727
15000		RA=RA+V(L)
15100		CALL BGSORT(RA)
15200		GO TO 2726
15300	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
15400	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
15500	732	DO 2606 K=NW,NWZ
15600	2606	BNW(K)=BNW(K+1)
15700		NWZ=NWZ-1
15800		IF(NWZ.EQ.0)GO TO 2111
15900		IF(NWZZ.EQ.1)GO TO 5111
16000		NWZZ=1
16100		IF(NWZ.EQ.1)GO TO 1111
16200		DO 3111 K=1,NWZ
16300		IF(BNW(K).LT.1000.)GO TO 3111
16400		X=BNW(NWZZ)
16500		BNW(NWZZ)=BNW(K)
16600		BNW(K)=X
16700		NWZZ=NWZZ+1
16800	3111	CONTINUE
16900	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17000		L=NWZZ+1
17100		X=BNW(NWZZ)
17200		DO 4111 K=L,NWZ
17300		IF(BNW(K).GT.X)GO TO 4111
17400		RA=BNW(K)
17500		BNW(K)=X
17600		X=RA
17700	4111	CONTINUE
17800		BNW(NWZZ)=X
17900		GO TO 1111
18000	111      FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18100		1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2,4X,
18200		1'RANDOM NUMBER =',I6/)
18310	1023	FORMAT(/'  <  ',A5,'.DAT '/1XA5)
18400	C********** BELOW IS FOR 'SECTIONS'
18500	9150	FORMAT(/3X'******* SECTION ',A1)
18600	2111	NWZ=-1
18700	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
18800	1111	IF(MZ.EQ.0)GO TO 1601
18900	      IF(NWX.NE.1)GO TO 1486
19010	      WRITE(JOUT,111)ISLAC,IFLNM,I,TF,IXIN
19100	C*********** JUNE 1,71
19200	C********** BELOW IS FOR 'SECTIONS'
19300	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19400		K=NWX-1
19500	C*********** JUNE 1,71
19600	          IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
19700		IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
19800	C*********** JUNE 1,71    X 3     K'S
19900	
20000	      DO 602 K=1,NINS   
20100	48	LK=INST(K)
20200	C*********** JUNE 1,71
20300	  	IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
20400		NCNT(K,31)=1
20500		IJ=IPT(K,31)
20600		X=0
20700		IF(IJ.NE.0)X=V(IJ+2)
20800	      WRITE(JOUT,5396),LK,X
20900		X=DUR(K)
21000	      IF(X.GT.10000.)GO TO 83 
21100	      WRITE(JOUT,8396),X     
21200		GO TO 602
21300	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
21400	7396      FORMAT('+',F5.0,' NOTES')    
21500	8396      FORMAT('+',F6.2,'"')   
21600	83      X=X-10000.
21700	      WRITE(JOUT,7396),X    
21800	602	CONTINUE
21900	715	IF(IT3.NE.1.)GO TO 1602
22000		RA=T1*TP
22100		RB=T2*TP
22200	      WRITE(JOUT,6154),RA,RB,TDUR  
22300	      IT3=0  
22400	1602	IF(NWX.EQ.1)GO TO 315
22500	      IF(IT(J).EQ.-3)GO TO 1108
22600	C*********** JUNE 1,71
22700	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
22800	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
22900	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23000	902      FORMAT(1XA5/)  
23100	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23200	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
23300	C*********** JUNE 1,71
23400		IT(J)=IT(J)/10
23500		GO TO 1108
23600	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
23700		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
23800	1601  IF(NWX.GT.1) GO TO 1108
23910		IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
24000		IF(TF.GT.10.)TF=TF/60.
24100		TF=1000./TF
24200		DO 6015 K=1,30
24300	6015	COPY(K)=-9900.
24400	C  INITS PARAM REPRESSION FEATURE.
24500	      IF(KB.EQ.0)GO TO 9926   
24600	      ML=NINS+1   
24700	      NL=NINS+KB
24800	      DO 9826 K=ML,NL   
24900	9826      BG(K)=OTH(K-NINS,1) 
25000	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
25100	9926      DO 5015 K=1,NINS    
25200		IQ(K)=BG(K)*10000.
25300	      BG(K)=0
25400		INP(K)=0
25500	      P1(K)=0     
25600		IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
25700	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
25800	5015      CNT(K)=0
25910		IF(MX)WRITE(1,1023)ISLAC,PLAY
26000	      BW=0 
26100		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108      M=0 
00300	      JC=0  
00400		IF(NWZ)GO TO 1740
00500	C  NWZZ IS SET AT 3111 IN SORTR.
00600		DO 740 K=1,NWZZ
00700	      X=BNW(K)    
00800		IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900		IT(J)=IT(J)*10
01000	      NW=K  
01100	      GO TO 600   
01200	2740	IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300	      X=BT+PR     
01400	      NW=K  
01500		BX=CNT(J)+1.
01600	      IT(J)=-3    
01700	      GO TO 600   
01800	740      CONTINUE 
01900	      IT(J)=0     
02000	1740      IF(J.LE.NINS)GO TO 31   
02100	7021      K=J-NINS
02200	      IF(JC.GT.0)K=JC   
02300	5740      IF(PP1.LT.OP1)GO TO 1752 
02400	      IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
02500	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
02600	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
02700	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
02800		DO 17521 L=3,30
02900	17521	COPY(L)=-9900.
03000	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100	1752	BG(K+NINS)=19999.
03200		OTH(K,1)=19999.
03300	      IF(JC.GT.0)GO TO 21     
03400	31      KL=1
03500	      IF(KB.EQ.0)GO TO 2031   
03600	      DO 1031 L=1,KB    
03700		K=L
03800	      X=OTH(K,1)-1000000.     
03900	      M=X/100000. 
04000	      IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031   
04100	C   M=INST  
04200	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
04300	1031	CONTINUE
04400		IF(J.GT.NINS)GO TO 500
04500	2031      CNT(J)=CNT(J)+1   
04600	      ICT=CNT(J)  
04700	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800	      NPA=NP(J)   
04900	      PP1=P1(J)  
05000	      IF(BT.GE.DUR(J))GO TO 5174    
05100		IF(IQ(J).EQ.0)GO TO 200
05200		P2=-IQ(J)/10000.
05300		IQ(J)=0
05400		CNT(J)=-1
05500		ICT=-1
05600		GO TO 4203
05700	
05800	C   MK IS FLAG FOR RESTS
05900	200	MK=0
06000	      IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203    
06100		KN=IPT(J,1)-1
06200		IF(KN.GT.0)GO TO 12033
06300	12032	KN=JPT(-KN)
06400		IF(KN)GO TO 12032
06500		KN=KN-1
06600	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
06700	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800	12033	IJ=V(KN)
06900		IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000	C   'IABS' IS FOR -4 USED WITH 'ALL'
07100	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
07200	C******* FEB 19,71
07300		IF(Z.GT.1.)Z=1.
07400		Y=V(KN+3)
07500		X=(V(KN+4)-Y)*Z+Y
07600	C******* FEB 19,71
07700		GO TO 204
07800	1203	X=V(KN+3)
07900	204	Y=RAND(0.0,1.0)
08000		IF(Y-X)MK=-1
08100	
08200	203	DF=1.
08300	C   DF=DUTY FACTOR 
08400		DO 2155 L=2,NPA
08500		ISUB=0
08600	C  WHY DOES ISUB APPEAR AT 14700/5?
08700		IDF=0 
08800	C    IDF IS DUTY FACTOR FLAG
08900		IJ=IPT(J,L)
09000	12031	IF(IJ)IJ=JPT(-IJ)
09100		IF(IJ)GO TO 12031
09200	C  FOLLOWS UP ON POINTERS TO POINTERS!
09300		PM=1.
09400		IF(IJ.GT.1)GO TO 2157
09500		P(L)=0
09600		GO TO 21551
09700	C 7/73
09800	2157	LN=IJ+2
09900		NM=ABS(V(IJ-1))+LN-4
10000		NL=V(IJ)
10100		IF(NL.GT.-200)GO TO 372
10200		ISUB=-1
10300		NL=NL+200
10400	C FOR SUBROUTINE FLAG
10500	372	IF(NL.GT.-100)GO TO 272
10600		IDF=-1
10700		NL=NL+100
10800	C  DEC.6,72  FINDS DUTY FACTOR PARAM
10900	272	VIJ2=V(IJ+1)
11000		KN=NL/(-11)
11100		IF(KN.EQ.0)GO TO 1100
11200		GO TO (61,62,62,62,65,65,67,68),KN
11300	1100	IF(VIJ2.EQ.1.)GO TO 1200
11400		ML=3
11500	1900	KA=1
11600		VX1=0
11700		DO 1156 K=LN,NM,ML
11800		VX(KA+1)=V(K)+VX(KA)
11900	1156	KA=KA+1
12000		X=RAND(0.0,1.)
12100		DO 1157 K=2,11
12200		IF(X.GT.VX(K))GO TO 1157
12300		KL=K-1
12400		IF(KN.EQ.7)GO TO 6157
12500		GO TO 1400
12600	1157	CONTINUE
12700	1400	LN=IJ+3*KL
12800	1462	RA=V(LN)
12900		IF(RA.EQ.10000.)GO TO 5174
13000	C   FOR "FINE" IN RLIST
13100		RB=V(LN+1)
13200		PAR=RAND(RA,RB)
13300	1300	IF(NL.NE.-1)PM=2.
13400	C  IF 2 THEN PRINTS A5
13500		GO TO 1155
13600	1200	PAR=V(IJ+2)
13700		GO TO 1300
13800	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
13900	61	IF(NL.LT.-12)GO TO 6100
14000	601	X=P2
14100	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14200		CALL SUBR
14400	CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
14500	C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
14600		IF(L.EQ.2)GO TO 4203
14700		IF(X.EQ.P2)GO TO 21552
14800		PP2=P2
14900		PR=P2
15000		GO TO 21552
15100	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15200	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15300	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15400	C  BE SET TO 'REAL TIME'.)
15500	
15600	C   NEXT IS FOR QUAD ROUTINES
15700	6100	CALL QUAD(NL)
15800		GO TO 21552
15900	
16000	C   FOLLOWING IS FOR STRINGS OF VALUES.  
16100	62      KL=NCNT(J,L)+1
16200		IF(KL.GT.VIJ2)KL=1 
16300		IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
16400	C   THIS PART FOR STRINGS OF RAND SELECTION
16500		LN=KL+IJ+1
16600		KL=KL+1
16700		IF(KL.GT.VIJ2)KL=1 
16800		NL=NL+45
16900	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
17000	162	NCNT(J,L)=KL
17100		IF(NL.GT.-22)GO TO 1462
17200	C   JUMP RAND SELECTION
17300	      PAR=V(IJ+KL+1)
17400	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
17500	C************************
17600		IF(KN.NE.3)GO TO 1155
17700	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
17800		IF(PAR.EQ.10000.)GO TO 5174
17900		PM=2.
18000		IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
18100		IF(PAR.EQ.85.)MK=-1
18200	      GO TO 5155  
18300	65	W=-9900.-V(IJ-3)
18400	C  W=BG TIME OF MOVE.
18500		X=ABS(V(IJ-1))
18600		IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
18700		Z=(BT-W)/VIJ2
18800	C  Z= % OF WAY THROUGH.
18900		IF(Z.GT.1.)Z=1.
19000		Y=V(LN)
19100		W=V(IJ+3)
19200		IF(X.EQ.7.)W=V(IJ+4)
19300		IF(NL.LT.-58)GO TO 16002
19400		PAR=(W-Y)*Z+Y
19500		IF(X.EQ.7.)GO TO 1600
19600		GO TO 1155
19700	C************** JUNE 1,71
19800	C   FOR "MOVX"
19900	C******** FEB/73
20000	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
20100	16002	PAR=RMOVX(W,Y,Z)
20200	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
20300	C  THIS NEEDS WORK!
20400		IF(X.NE.7.)GO TO 1155
20500		W=V(IJ+5)
20600		Y=V(IJ+3)
20700		X=RMOVX(W,Y,Z)
20800		GO TO 16003
20900	C  NEXT IS FOR MOVING RAND RANGES.
21000	C1600	PAR=(V(IJ+4)-Y)*Z+Y
21100	1600	W=V(IJ+3)
21200	C*********** BACK TO 65 IS NEW.   FEB. 15,71
21300		X=(V(IJ+5)-W)*Z+W
21400	C************ JUNE 1,71   
21500	16003	PAR=RAND(PAR,X)
21600		GO TO 1155
21700	67	LN=IJ+3
21800		NM=LN+VIJ2-1
21900		ML=1
22000		GO TO 1900
22100	4155	K=(PAR-9999.0)*100.+.1	
22200		P(L)=P(K)
22210		IF(L.EQ.2.AND.K.EQ.2)P2=PX2
22220	C  PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
22300		PM=PL(K)
22400		GO TO 21551
22500	C   ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
22510	C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
22520	C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
22530	C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
22540	C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
22600	6157	LN=V(LN-1)
22700		DO 1068 K=1,KL
22800	1068	IF(K.LT.KL)LN=LN+V(LN)+1
22900	2068	PM=LN+1
23000		PAR=LN+V(LN)
23100		GO TO 5155
23200	68	KL=NCNT(J,L)
23300		IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
23400		PM=KL+1
23500		PAR=PM+V(KL)-1
23600		KL=PAR+1
23700		IF(V(KL).EQ.10000.)DUR(J)=BT
23800	C  'END' OR 'FINE' IN 'LIT' LIST.
23900		IF(V(KL).EQ.999.)KL=IJ+2
24000		NCNT(J,L)=KL
24100		GO TO 5155
24200	C ******* JAN 20  *************
24300	1155	IF(PAR.EQ.10000.)GO TO 5174
24400	C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
24500		IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
24600	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
24700	5155	P(L)=PAR
24800	21551	PL(L)=PM
24900		IF(ISUB)GO TO 601
25000		IF(L.EQ.2)GO TO 4203
25100	21552	IF(IDF.GE.0)GO TO 2155
25200		DF=PAR
25300	C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
25400		IDF=0
25500	2155	CONTINUE
25600	
25700	9203      IF(KB.EQ.0)GO TO 1170     
25800	       NL=KB
25900	      DO 2203 K=1,KB    
26000	      X=OTH(NL,1) 
26100	      IF(X.LT.100000.)GO TO 2203     
26200	      L=X/100000.
26300	      Y=(X-L*100000.)/100.    
26400	      IX=Y  
26500	      JC=NL 
26600	      IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203    
26700	2203  NL=NL-1     
26800	      GO TO 1170  
26900	4203      PR=P2 
26910		PX2=P2
26920	C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
27000	      IF(T5.EQ.0)GO TO 7203   
27100		IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
27200	3155	IT3=IT3+3
27300		TBG=TBG+TDUR
27400		TDUR=V(IT3)
27500		IF(BT.GE.TBG+TDUR)GO TO 3155
27600		T1=V(IT3+1)
27700		T2=V(IT3+2)
27800		CALL SQYY(AC,T1,T2,TDUR)
27900	6203	RA=PR 
28000		IF(BT.EQ.TBG)XT(J)=T1
28100		K=IT3
28200		RC=0  
28300		RD=1  
28400		KA=1  
28500		RB=0  
28600		Z=TDUR+TBG-BT	
28700		X=T1  
28800		Y=T2  
28900		YY=AC
29000		CHN=TBG	
29100		ZZ=TDUR	
29200		GO TO 4020  
29300	8203	P2=RA*RD    
29400	7203	P2=P2*T4
29500		X=P2*TF
29600	C  P2 IS KEPT WITHOUT TF*
29700		K=X+.5
29800		IF(X)K=X-.5
29900	72031	ROFF(J)=ROFF(J)+K-X
30000		IF(ABS(ROFF(J)).LT.1.)GO TO 7155
30100		Y=1.
30200		IF(ROFF(J))Y=-1.
30300		K=K-Y
30400		ROFF(J)=ROFF(J)-Y
30500	C  ROUND-OFF GAP WILL NOT EXCEED .001
30600	C*********** FEB 17,71
30700	7155	PP2=K/1000.
30800	C   AVOIDS ROUND-OFF PROBLEMS
30900	C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
31000		IF(IPT(J,31).EQ.0)GO TO 6155
31100		IF(ICT)GO TO 1170
31200		X=V(IPT(J,31)+2)/2.
31300		Y=RAND(-X,X)
31400		IF(PP2.GE.0)GO TO 615
31500		MK=-1
31600		PP2=-PP2
31700	615	PP2=PP2-RDEV(J)+Y
31800		RDEV(J)=Y
31900	C  TOTAL RAND DEV. WON'T EXCEED P31
32000	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
32100	
32200		K=PP2*1000.+.5
32300	C****** CHECK THIS OUT  1/10/72 :::::::
32400	61551	PP2=K/1000.
32500	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
32600	6155	IF(ICT)GO TO 9203
32700		GO TO 2155
32800	5203      JD=Y*100-IX*100+.5  
32900	      IF(JD.GT.0)GO TO 3203   
33000		M=0
33100		P1(J)=PP1+PP2
33200	      GO TO 7021  
33300	3203      P(JD)=OTH(JC,2)     
33400		X=OTH(JC,3)
33500		IF(X.NE.1.)X=3.
33600	C   'EDITS' PRINT,NUM. OR 5 CHARS.
33700	      PL(JD)=X
33800	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
33900		IF(JD.EQ.2)PP2=P2
34000	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
34100	1170      IF(MK.OR.PP2)GO TO 2022   
34200	
34300		ZPAR=PP1
34400		P1(J)=PP1+PP2
34500	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
34600		LK=INST(J)
34700	2021	IF(PP1.LT.OP1)GO TO 2612
34800		IF(INVIS(J).LT.0)GO TO 2170
34900	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
35000		IF(INONLY.GT.0)GO TO 1204
35100	C*********** MAY 16,71 ↑↑↑
35200	6021	IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
35300	C******* MAY 25,71
35400	C  'LIT' DATA WILL ALWAYS PRINT.
35500		NPA=NPA-1
35600		IF(NPA.GT.2)GO TO 6021
35700	5021	DO 1304 K=3,NPA
35800	1304	COPY(K)=P(K)
35900	1204	IF(PL4.NE.1.)GO TO 2170
36000		P4=P4*AMPFAC
36100		L=0
36200		INP(J)=P4
36300		DO 1021	K=1,NINS
36400	1021	IF(P1(K).GT.PP1)L=L+INP(K)
36500		IF(L-IAMP-1)GO TO 2170
36600		IAMP=L
36700		AMPTIM=PP1
36800	2170	IF(MX.EQ.3)GO TO 2612
36900	C ********* MAY 17,71
37000	      PP1=PP1-OP1     
37100	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
37200		IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
37300		IF(INONLY)WRITE(JOUT,902)
37400		A=PP1+.05
37500	5170	ML=10
37600		IF(NPA.LT.10)ML=NPA
37700		MLX=3
37800		NL=2
37900		IF(INVIS(J).EQ.0)GO TO 3170
38000		LK=0
38100	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
38200	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
38300	31701	KL=3
38400		GO TO 4170
38500	3170	IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
38600		VX(1)=PP1
38700		IF(DF.GT.0)GO TO 6170
38800		VX2=-DF
38900		IF(VX2.GT.PP2)VX2=PP2
39000	C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
39100		GO TO 7170
39200	6170	IF(DF.LT.100)GO TO 8170
39300	C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
39400		VX2=PP2-DF+100.
39500		IF(VX2.LE.0)VX2=PP2/2.
39600	C NO NEG. TIME VALUES ALLOWED.
39700		GO TO 7170
39800	8170	VX2=PP2*DF
39900	7170	IFM3='F9.3,'
40000		IFM4=IFM3
40100		KL=5
40200		IF(NPA.LT.3)GO TO 2121
40300	
40400	4170	NL=2
40500		DO 1121 K=MLX,ML
40600		X=P(K)
40700		L=PL(K)
40800		IF(L-2)321,521,621
40900	C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
41000	321	IF(X.GE.0)GO TO 4211
41100		IFM(KL)=IFCOM
41200		NL=NL+1
41300		KL=KL+1
41400	4211	IFM(KL)='F9.3,'
41500	C   CREATES 'F9.3'
41600	421	VX(KL-NL)=X
41700		GO TO 1121
41800	521	IFM(KL)=IFM2
41900	C   CREATES '1XA5'
42000		LN=X
42100		VX(KL-NL)=SCAL(LN)
42200		GO TO 42
42300	621	IF(L.GT.3)GO TO 721
42400		VX(KL-NL)=X
42500	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42600	42	IFM(KL)=IFM2
42700		GO TO 1121
42800	721	LN=X
42900		IFM(KL)=I1X
43000		NL=NL+1
43100		DO 821 M=1,LN-L+1
43200		KL=KL+1
43300		IOUT(KL-NL)=IV(L-1+M)
43400	821	IFM(KL)=IA1
43500	1121	KL=KL+1
43600	
43700	C  NO MORE THAN 80 ITEMS IN FORMAT.
43800	2121	IF(KL.LE.80)GO TO 21211
43900	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
44000		TYPE 21212
44100	21211	DO 921 M=KL+1,80
44200	921 	IFM(M)=IBLA
44300		IFM(KL)=')'
44400		L=KL-NL-1
44500		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
44600		IF(.NOT.MZ)GO TO 30210
44700		IF(ML.GE.NPA)IFM(KL)='$)'
44800		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
44900	30210	IF(ML.GE.NPA)GO TO 3021
45000		MLX=ML+1
45100		ML=ML+10
45200		IF(ML.GT.NPA)ML=NPA
45300		LK=IBLA
45400		GO TO 31701
45500	3021	IF(MX)WRITE(1,3616)INST(J),ICT
45600	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
45700	2612      PP1=ZPAR     
45800	         GO TO 21 
45900	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
46000	3616	FORMAT(';PRINT(P1);< ',A5,I4)
46100	C   PRINTS RESTS  
46200	2022	PP2=ABS(PP2)
46300	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
46400	C   FOR RESTS IN SEQS. TYPE -DUR.   
46500	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
46600	C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
46700		INP(J)=0
46800		P1(J)=PP1+PP2
46900	C   STORES NEXT P1 TIME FOR THIS INST.
47000		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
47100	      X=PP1-OP1  
47200		IF(A.GE.X)GO TO 121
47300		WRITE(JOUT,902)
47400		A=X+.05
47500	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
47600		1 J,INST(J),ICT
47700	21	PR=ABS(PR)
47800	      BG(J)=BT+PR 
47900	      IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
48000	      IF(BG(J).LT.DUR(J))GO TO 500  
48100	5174      BG(J)=19999. 
48200	      DO 3174 K=1,NINS  
48300	C   INSERTS CANT FOLLOW LAST REGULAR NOTE.
48400	C   (ADD REST IF INSERT AT END IS NEEDED.)    
48500	3174      IF(BG(K).LT.19999.)GO TO 500     
48600	      GO TO 175   
48700	C   CHOOSES INST WITH NEXT BEGIN TIME.    
48800	500      J=1   
48900		BW=BT
49000	      NL=NINS+KB
49100	      DO 22 K=2,NL
49200	22      IF(BG(J).GT.BG(K))J=K 
49300		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
49400		J=1
49500		DO 5022 K=2,NINS
49600		X=P1(J)
49700		Y=P1(K)+.0001
49800	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
49900		IF(BG(J).EQ.19999.)X=19999.
50000		IF(BG(K).EQ.19999.)Y=19999.
50100	5022	IF(X.GT.Y)J=K
50200	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
50300	3022      BT=BG(J)    
50400	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
50500		IF(CNT(J).GT.0)GO TO 1022
50600	      IF(CNT(J).EQ.0)P1(J)=0  
50700	      IF(CNT(J).EQ.-1)CNT(J)=0
50800	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
50900	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
51000	      T4=T2 
51100	      T5=0  
51200	      T6=10000.   
51300	      GO TO 1108    
51400	1175	FORMAT('+',A5,'=',F7.3,2X,$)
51510	1109	FORMAT(' FINISH; < ',A5,'.DAT')
51600	1110	FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
51700	1603  FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
51800		1,F8.3)
51910	175	IF(MZ)WRITE(JOUT,1109),ISLAC
52000		IF(MX.GE.0)GO TO 4175
52110		WRITE(1,1109),ISLAC
52200		END FILE 1
52300	603	FORMAT(' TOTAL DURS:  ',$)
52400	4175	CALL ENDSUB
52500	C  CLEARS CNTL O --- IF YOU HAVE HIT IT.
52600		WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
52700		WRITE(JOUT,603)
52800	5175	DO 2175 K=1,NINS
52900		X=P1(K)-OP1
53000		IF(MZ)GO TO 6175
53100		TYPE 1175,INST(K),X
53200		GO TO 2175
53300	6175	WRITE(JOUT,1175),INST(K),X
53400	2175	CONTINUE
53510	3175	TYPE 1023,ISLAC
53600		END